home *** CD-ROM | disk | FTP | other *** search
/ Apple II Magazines (PO) / Nibble Volume 13, No. 04 (1992-04)(MindCraft Publishing)(Side A).zip / Nibble Volume 13, No. 04 (1992-04)(MindCraft Publishing)(Side A).po / LPPC.ASM.txt < prev    next >
Text File  |  1996-12-24  |  8KB  |  177 lines
  1. ********************************
  2. *   Long Peek, Poke, and Call  *
  3. *   by Tom Peng                *
  4. *                              *
  5. *   Copyright (C) 1992 by      *
  6. *   MindCraft Publishing Corp. *
  7. *   Lincoln, MA 01773          *
  8. ********************************
  9.  
  10.          keep  lplplc
  11.          msb   on                       ;keep most sig. bit on
  12.          org   $8000
  13.  
  14. ampvect  gequ  $3f5                     ;Ampersand jump vector
  15. chargot  gequ  $00b7                    ;Get current char
  16. charget  gequ  $00b1                    ;Get next char
  17. synchr   gequ  $dec0                    ;Print SYNTAX ERROR
  18. frmevl   gequ  $dd7b                    ;Formula evaluator
  19. conint   gequ  $e6fb                    ;Convert FAC to integer
  20. chkcom   gequ  $debe                    ;Check for comma
  21. getadr   gequ  $e752                    ;Convert FAC to 2 byte integer
  22. ptrget   gequ  $dfe3                    ;Address of variable into Y,A
  23. cout     gequ  $fded                    ;Print character
  24. varpnt   gequ  $83                      ;Address returned by ptrget ($83/$84)
  25. linnum   gequ  $50                      ;Address returned by getadr ($50/$51)
  26. addr     gequ  $0                       ;Temp. storage
  27. bank     gequ  $2                       ;Temp. storage
  28. number   gequ  $4                       ;Temp. storage
  29.  
  30.          longi off                      ;8 bit A,X,Y
  31.          longa off
  32.  
  33. setup    start
  34.          lda   #$4c                     ;Set up ampersand vector
  35.          sta   ampvect
  36.          lda   #<begin
  37.          sta   ampvect+1
  38.          lda   #>begin
  39.          sta   ampvect+2
  40.          ldy   #0
  41. nextchar lda   message,y                ;Print init. message
  42.          cmp   #0
  43.          beq   stop
  44.          jsr   cout
  45.          iny
  46.          jmp   nextchar
  47. stop     rts
  48.  
  49. ;        -------------------------------
  50.  
  51. begin    anop                           ;Actual handling routine starts here
  52.          jsr   chargot                  ;Get current char after "&"
  53.          cmp   #$e2                     ;Check if "PEEK" token found
  54.          beq   peek                     ;Yes, branch!
  55.          cmp   #$b9                     ;Check if "POKE" token found
  56.          beq   poke                     ;Yes, branch!
  57.          cmp   #$8c                     ;Check if "CALL" token found
  58.          beq   call                     ;Yes, branch!
  59.          jmp   synerr                   ;Syn. err. occured
  60.  
  61. poke     jsr   charget                  ;Skip POKE token
  62.          jsr   frmevl                   ;Evaluating value for bank
  63.          jsr   conint                   ;Convert result to integer
  64.          stx   bank                     ;Put integer in bank
  65.          jsr   chkcom                   ;Check for comma
  66.          jsr   frmevl                   ;Evalute value for address
  67.          jsr   getadr                   ;Convert result into 2 byte integer
  68.          lda   linnum                   ;put first byte in storage
  69.          sta   addr
  70.          lda   linnum+1                 ;put second byte in storage
  71.          sta   addr+1
  72.          jsr   chkcom                   ;Check for comma
  73.          jsr   frmevl                   ;Evaluate value for number
  74.          jsr   conint                   ;Convert to integer
  75.          stx   number                   ;put it in number
  76.  
  77.          longi on                       ;16 bit A,X,Y
  78.          longa on
  79.          rep   #$30
  80.          lda   number                   ;Get number
  81.          sta   [addr]                   ;Put it in destinate location
  82.          sep   #$30                     ;8 bit A,X,Y
  83.          longi off
  84.          longa off
  85.          rts                            ;To applesoft
  86.  
  87. peek     jsr   charget                  ;Skip PEEK token
  88.          jsr   frmevl                   ;Evaluate value for bank
  89.          jsr   conint                   ;Convert into integer
  90.          stx   bank                     ;store it in bank
  91.          jsr   chkcom                   ;check for comma
  92.          jsr   frmevl                   ;Evaluate value for address
  93.          jsr   getadr                   ;Convert to 2 byte integer
  94.          lda   linnum                   ;put first byte in storage
  95.          sta   addr
  96.          lda   linnum+1                 ;put second byte in storage
  97.          sta   addr+1
  98.          longi on                       ;16 bit A,X,Y
  99.          longa on
  100.          rep   #$30
  101.          lda   [addr]                   ;Get result from destinate location
  102.          sep   #$30                     ;8 bit A,X,Y
  103.          longa off
  104.          longi off
  105.          pha                            ;Push result
  106.          jsr   chkcom                   ;Check for comma
  107.          jsr   ptrget                   ;Find the address of variable
  108.          ldy   #$0
  109.          lda   #$0
  110.          sta   (varpnt),y
  111.          iny
  112.          pla
  113.          sta   (varpnt),y               ;Put result into address
  114.          rts                            ;To applesoft
  115.  
  116. call     jsr   charget                  ;Skip CALL token
  117.          jsr   frmevl                   ;Evaluate value for bank
  118.          jsr   conint                   ;Convert to integer
  119.          stx   ljump+3                  ;Put it somewhere
  120.          jsr   chkcom                   ;Check for comma
  121.          jsr   frmevl                   ;Evaluate value for address
  122.          jsr   getadr                   ;Convert to 2 byte integer
  123.          lda   linnum                   ;put lo-byte somewhere
  124.          sta   ljump+1
  125.          lda   linnum+1                 ;put hi-byte somewhere
  126.          sta   ljump+2
  127.          jsr   chkcom                   ;Check for comma
  128.          jsr   frmevl                   ;Evaluate for Accumulator
  129.          jsr   conint                   ;Convert to integer
  130.          cpx   #2                       ;Less than 2?
  131.          bpl   synerr                   ;No! So error
  132.          stx   rega                     ;Put in rega
  133.          jsr   chkcom                   ;Check for comma
  134.          jsr   frmevl                   ;Evaluate for index registers
  135.          jsr   conint                   ;convert to integer
  136.          cpx   #2                       ;Less than 2?
  137.          bpl   synerr                   ;No! So ERROR
  138.          stx   regi                     ;Put in regi
  139.          jsr   chkcom                   ;Check for coma
  140.          jsr   frmevl                   ;Evaluate for mode
  141.          jsr   conint                   ;Convert to integer
  142.          cpx   #2                       ;Less than 2?
  143.          bpl   synerr                   ;No! So ERROR
  144.          stx   eflag                    ;put in eflag
  145.          lda   rega                     ;Get rega
  146.          cmp   #1                       ;Equal to 1?
  147.          beq   tregi                    ;Yes! Goto tregi
  148.          rep   #$20                     ;Set 16 bit accumulator
  149. tregi    lda   regi                     ;Get regi
  150.          cmp   #1                       ;Equal to 1?
  151.          beq   teflag                   ;Yes! Goto teflag
  152.          rep   #$10                     ;Set 16 bit index register
  153. teflag   lda   eflag                    ;Get eflag
  154.          cmp   #1                       ;Equal to 1?
  155.          beq   ljump                    ;Yes! Goto ljump
  156.          clc                            ;Set native mode
  157.          xce
  158. ljump    jsl   $ffffff                  ;Jump to destinate location
  159.          sec                            ;8 bit A,X,Y and emulation mode
  160.          xce
  161.          sep   #$30
  162.          rts                            ;To applesoft
  163.  
  164. synerr   lda   #$ff                     ;Display ?SYNTAX ERROR message
  165.          jmp   synchr
  166.  
  167. message  dc    c'Long Peek, Poke, and Call',h'8d'
  168.          dc    c'ampersand routine installed',h'8d8d'
  169.          dc    c'by Tom Peng',h'8d'
  170.          dc    c'Copyright (C) 1992, MindCraft Publ.',h'8d8d00'
  171.  
  172. rega     ds    2
  173. regi     ds    2
  174. eflag    ds    2
  175.  
  176.          end
  177.